home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok18.lha / IFFLib / ShowIFF.mod < prev    next >
Text File  |  1993-08-15  |  3KB  |  99 lines

  1. (*---------------------------------------------------------------------------
  2.     :Program.    ShowIFF.mod
  3.     :Author.     Fridtjof Siebert
  4.     :Address.    Nobileweg 67, D-7-Stgt-40
  5.     :Shortcut.   [fbs]
  6.     :Version.    1.0
  7.     :Date.       25-Feb-89
  8.     :Copyright.  PD
  9.     :Language.   Modula-II
  10.     :Translator. M2Amiga v3.1d
  11.     :Imports.    IFFLib [fbs]/Christian A. Weber
  12.     :Contents.   Demonstration for IFFLib. Dispays a Picture
  13.     :Remark.     You must have iff.library in your LIBS: directory.
  14.     :Remark.     Original C-Version by Christian A. Weber
  15.     :Usage.      ShowIFF <IFF-Pic>
  16. ---------------------------------------------------------------------------*)
  17.  
  18. MODULE ShowIFF;
  19.  
  20. FROM SYSTEM    IMPORT ADDRESS, ADR;
  21. FROM Arts      IMPORT Terminate;
  22. FROM Arguments IMPORT NumArgs, GetArg;
  23. FROM Dos       IMPORT Delay;
  24. FROM Graphics  IMPORT LoadRGB4;
  25. FROM InOut     IMPORT WriteString, WriteInt, WriteLn;
  26. FROM Intuition IMPORT NewScreen, ScreenPtr, ScreenFlagSet, ScreenFlags,
  27.                       customScreen, OpenScreen, CloseScreen;
  28. FROM Terminal  IMPORT waitCloseGadget;
  29. FROM IFFLib    IMPORT BitMapHeaderPtr, CloseIFF, OpenIFF, GetViewModes,
  30.                       IffError, GetBMHD, GetColorMap, DecodePic;
  31.  
  32. VAR
  33.   ns: NewScreen;
  34.   myscreen: ScreenPtr;
  35.   ifffile: ADDRESS;
  36.   colortable: ARRAY[0..127] OF CHAR;
  37.   bmhd: BitMapHeaderPtr;
  38.   count: LONGINT;
  39.   i: INTEGER;
  40.   picname: ARRAY[0..79] OF CHAR;
  41.   Ciapra [0BFE001H]: SET OF (s0,s1,s2,s3,s4,s5,lmb);
  42.  
  43. PROCEDURE Fail(error: ARRAY OF CHAR);
  44.  
  45. BEGIN
  46.   IF ifffile #NIL THEN CloseIFF(ifffile) END;
  47.   IF myscreen#NIL THEN CloseScreen(myscreen) END;
  48.   WriteString(error); WriteLn;
  49.   WriteString("IffError: "); WriteInt(IffError(),5); WriteLn;
  50.   Terminate(0);
  51. END Fail;
  52.  
  53. BEGIN
  54.   ifffile := NIL; waitCloseGadget := FALSE;
  55.  
  56.   IF NumArgs()<1 THEN WriteString("Format: ShowIFF <FileName>") END;
  57.  
  58.   GetArg(1,picname,i);
  59.  
  60.   WriteString("Loading file "); WriteString(picname); WriteString(" ... ");
  61.  
  62.   ifffile := OpenIFF(ADR(picname));
  63.   IF ifffile=NIL THEN Fail("Error opening file") END;
  64.  
  65.   bmhd := GetBMHD(ifffile);
  66.   IF bmhd=NIL THEN Fail("BitMapHeader not found") END;
  67.   WITH ns DO
  68.     leftEdge     := 0; topEdge := 0;
  69.     WITH bmhd^ DO
  70.       width      := w; height  := h;
  71.       depth      := nPlanes;
  72.     END;
  73.     viewModes    := GetViewModes(ifffile);
  74.     type         := ScreenFlagSet{screenQuiet} + customScreen;
  75.     font         := NIL;
  76.     defaultTitle := ADR("ShowIFF screen");
  77.     gadgets      := NIL;
  78.     customBitMap := NIL;
  79.   END;
  80.  
  81.   myscreen := OpenScreen(ns);
  82.   IF myscreen=NIL THEN Fail("Can't open screen!") END;
  83.  
  84.   count := GetColorMap(ifffile,ADR(colortable));
  85.   IF count>32 THEN count:=32 END;
  86.   LoadRGB4(ADR(myscreen^.viewPort),ADR(colortable),count);
  87.  
  88.   IF NOT DecodePic(ifffile,ADR(myscreen^.bitMap)) THEN
  89.     Fail("Can't decode the picture");
  90.   END;
  91.  
  92.   i := 0;
  93.   WHILE (lmb IN Ciapra) AND (i<100) DO Delay(5); INC(i) END;
  94.  
  95.   Fail("done"); (* Close the whole stuff *)
  96.  
  97. END ShowIFF.
  98.  
  99.